home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / prog / uniforth.zip / HAM.FTH < prev    next >
Text File  |  1988-11-03  |  3KB  |  74 lines
  1. ( this file simulates a Hamming error correction system. a code is calculated 
  2.   in the transmitter, the integrity is checked in the receiver, and a channel
  3.   is simulated which inserts errors based on an adjustable random number
  4.   generator)
  5.  
  6.  
  7.  
  8. VOCABULARY HAMMING
  9. HAMMING                     ( SET CONTEXT TO HAMMING)
  10. HAMMING DEFINITIONS         ( ADD DEFINITIONS TO HAMMING VOCABULARY)
  11. ( --------------------USEFUL WORDS ---------------------------------------)
  12. : MOD2+     ( N1,N2--MOD2_N3)  + 01 AND ;
  13. : 3SHR   ( N1--N1_SHIFTED)  2* 2* 2* ;
  14. : 2^N  ( N1--2^N1)   DUP 0= IF DROP 1 ELSE 1 SWAP 0 DO 2* LOOP THEN ;
  15.  
  16. ( ---------------------------TRANSMITTER----------------------------------)
  17. 7 VECTOR     TX'D
  18. : D1!D2!D3!D4!  ( N--)  4 0 DO    DUP  I 2^N  AND
  19. IF 1   3 I -   TX'D !   ELSE 0   3 I -   TX'D ! THEN      LOOP DROP ;
  20.  
  21. ( CHECK BIT CALCULATION)
  22. : D5!  ( --D5)  01  TX'D @   02  TX'D @   03  TX'D @  MOD2+ MOD2+
  23.                IF 1 04  TX'D ! ELSE 0  04  TX'D ! THEN   ;
  24. : D6!  ( --D6)  00  TX'D @   02  TX'D @   03  TX'D @  MOD2+ MOD2+
  25.                IF 1 05  TX'D ! ELSE 0  05  TX'D ! THEN   ;
  26. : D7!  ( --D7)  00  TX'D @   01  TX'D @   03  TX'D @  MOD2+ MOD2+
  27.                IF 1 06  TX'D ! ELSE 0  06  TX'D ! THEN   ;
  28.  
  29. ( TRANSMITTER ACCESS)
  30. : TX'ER!  ( DATA--)  D1!D2!D3!D4!    D5! D6! D7!  ;
  31. : TX'ER@   ( --) 0   7 0 DO   I TX'D @    6 I -  2^N *  +  LOOP  ;
  32.  
  33. ( ----------------------------RECEIVER------------------------------------)
  34. 7 VECTOR RX'D
  35. : RX'ER@   ( --) 0   7 0 DO   I RX'D @    6 I -  2^N *  +  LOOP  ;
  36. : RX'ER!   ( --)  7 0 DO   DUP   I 2^N AND
  37. IF 1   6 I -   RX'D !    ELSE 0   6 I -   RX'D !    THEN LOOP DROP ;
  38. ( SYNDROME CALCULATION, BIT CORRECTION)
  39. : S1  03 RX'D @   04 RX'D @   05 RX'D @   06 RX'D @   MOD2+ MOD2+ MOD2+  ;
  40. : S2  01 RX'D @   02 RX'D @   05 RX'D @   06 RX'D @   MOD2+ MOD2+ MOD2+  ;
  41. : S3  00 RX'D @   02 RX'D @   04 RX'D @   06 RX'D @   MOD2+ MOD2+ MOD2+  ;
  42.  
  43. ( PROSCRIPTION AND CORRECTION OF FAULTY BITS)
  44. : SYNDROME   ( --N)  4 S1 *  2 S2 *  1 S3 *   + +     ;
  45. : TOGGLE-BIT ( RX'D#--)  DUP RX'D @ 1 XOR SWAP RX'D ! ;
  46. : CORR-BIT  ( SYN--)   DUP  IF  1- TOGGLE-BIT  ELSE DROP THEN ;
  47.  
  48. ( -----------------RANDOM NUMBER GENERATOR--------------------------------)
  49. FVARIABLE RND
  50. : FSEED   GTIME CLKADR @    S>D   FLOAT  1/X    6.0 10**X F* ;
  51. ( CONVERT A # TO INTERVAL 0,1 )
  52. : (0,1)      FDUP   IFIX  IFLOAT     FMOD    ;
  53. ( RANDOM # IN INTERVAL 0,1 )
  54. : RANDOM  ( --N)  RND F@   69.069 F*   0.000232830   F+
  55.                   (0,1)    FDUP  RND F!  ;
  56.  
  57. FSEED  (0,1)   RND  F!
  58.  
  59. ( -------------------DATA AND CHANNEL SIMULATION--------------------------)
  60.  
  61. ( DATA SIMULATION, A RANDOM WORD IN INTERVAL 0,15 )
  62. : RND-WORD ( --N)    0    4 0 DO    0.500000  RANDOM  F>
  63. IF    1       I 2^N *   +
  64. ELSE  0       I 2^N *   +      THEN   LOOP ;
  65.  
  66. ( CHANNEL SIMULATION, ERRORS ARE INTRODUCED IAW P{BIT ERROR} )
  67. FVARIABLE PBE  ( PROB-BIT-ERROR)
  68. : CHANNEL  ( --)   PBE F@   RANDOM   F>   IF  1 XOR  THEN ;
  69. : TX'ER--->CHANNEL--->RX'ER   ( --)
  70. 7 0 DO   I TX'D @   CHANNEL  I RX'D !    LOOP ;
  71.  
  72.  
  73. ;S
  74.